{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
--
-- Module      :  LLVM.Code.Globals
-- Copyright   :  Mikhail Belyaev
-- License     :  GPL (Just (Version {versionBranch = [3], versionTags = []}))
--
-- Maintainer  :
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module LLVM.Code.Globals where

import LLVM.Parser.Record.Record
       (extrudeCustomRecords, extrudeData, RawBlock(..), BlockHeader(..),
        recordAsList, RecordType, fromRawRecord)
import LLVM.Util
import Data.List (genericIndex, genericLength)
import LLVM.Code.Shared
       (ValIndex(..), VisibilityType(..), vtFromInteger, LinkageType(..),
        ltFromInteger, VisibilityType, LinkageType, TypeIndex(..))
import LLVM.Code.Types (Type(..), getTypeByIndex)
import LLVM.Code.Values.Kinds (GlobalValue(..))
import LLVM.Code.Values (Value(..), TypedValue(..))


--    * pointer type: The type index of the pointer type used to point to this global variable
--    * isconst: Non-zero if the variable is treated as constant within the module, or zero if it is not
--    * initid: If non-zero, the value index of the initializer for this variable, plus 1.
--    * linkage: An encoding of the linkage type for this variable:
--          o external: code 0
--          o weak: code 1
--          o appending: code 2
--          o internal: code 3
--          o linkonce: code 4
--          o dllimport: code 5
--          o dllexport: code 6
--          o extern_weak: code 7
--          o common: code 8
--          o private: code 9
--          o weak_odr: code 10
--          o linkonce_odr: code 11
--          o available_externally: code 12
--          o linker_private: code 13
--    * alignment: The logarithm base 2 of the variable's requested alignment, plus 1
--    * section: If non-zero, the 1-based section index in the table of MODULE_CODE_SECTIONNAME entries.
--    * visibility: If present, an encoding of the visibility of this variable:
--          o default: code 0
--          o hidden: code 1
--          o protected: code 2
--    * threadlocal: If present and non-zero, indicates that the variable is thread_local

data GlobalDef = GlobalDef {
                    ptrType :: TypeIndex,
                    globalValue :: GlobalValue
                 }deriving (Show,Eq)

instance RecordType GlobalDef where
    fromRawRecord rr = case (recordAsList rr) of
                            (_:7:m0:m1:m2:m3:m4:m5:m6:m7:_) ->
                                Just (GlobalDef ptr_t $ GlobalValue is_c init_i link align sec vis isTL)
                                where
                                     ptr_t = TypeIndex m0
                                     is_c = m1 /= 0
                                     init_i = case m2 of
                                                   0 -> Nothing
                                                   x -> Just $ ValIndex (x-1)
                                     link = ltFromInteger m3 ?? External
                                     align = m4
                                     sec = m5
                                     vis = vtFromInteger m6 ?? DefaultVis
                                     isTL = m7 /= 0
                            otherwise -> Nothing

newtype Globals = Globals { globalsContents :: [GlobalDef] } deriving (Show,Eq)

emptyGlobals = Globals []

-- 8 is the id of module block
buildGlobals :: RawBlock -> Globals
buildGlobals rb | rb.$header.$blockId == 8 = Globals $ extrudeCustomRecords rb
buildGlobals _ = emptyGlobals


instance TypedValue GlobalDef where
    getType (GlobalDef ti _) tt = getTypeByIndex tt ti ?? LLOpaque
    toValue (GlobalDef _ gv) = GlobalV gv

